/* REXX _build_ship_catalog.zrx by the reverend (build 62)                    */
/*-       built by rev-builder version 1.1 on 02 Jan 2003 at 11:11:20        -*/
/*- ------------------------------------------------------------------------ -*/
/*-                       Copyright (C) 2001 Ron Wilson                      -*/
/*-                                                                          -*/
/*- This script is free, and can be modified for your personal use, but you  -*/
/*- cannot copy or distribute this script or any derivative work based upon  -*/
/*- this script without the express permission of the author. Your use of    -*/
/*- this script is governed by the terms of the REV-LICENSE.                 -*/
/*-                                                                          -*/
/*- This program is provided to you WITHOUT ANY WARRANTY, even the implied   -*/
/*- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -*/
/*- REV-LICENSE for more details.                                            -*/
/*-                                                                          -*/
/*-                A copy of the REV-LICENSE is available at:                -*/
/*-       http://thereverend.coastgames.com/tradewars/rev-license.html       -*/
/*- ------------------------------------------------------------------------ -*/
/* rev. 0 - initial release                                                   */

call zoctimeout 60
call zocsynctime 500
globals=_setglobals()
call on halt name _halt

if \_pcheck("Command [;Citadel command") then call _error "please start at the command prompt or in a citadel."
call _set_ship_catalog
call _quit "nocopy"

/***                 THE REVEREND'S TW LIBRARY FOR ZOC/REXX                 ***/

/** _setglobals v.3 **/
    _setglobals: procedure expose _verbose _monthdays _monthnames _baseday. (globals)
    
     _verbose=0
     _monthdays="31;28;31;30;31;30;31;31;30;31;30;31"
     _monthnames="jan;feb;mar;apr;may;jun;jul;aug;sep;oct;nov;dec"
     _baseday.2000=730118
     _baseday.2001=_baseday.2000+365+1
     _baseday.2002=_baseday.2001+365
     _baseday.2003=_baseday.2002+365
     _baseday.2004=_baseday.2003+365
     _baseday.2005=_baseday.2004+365+1
     _baseday.2006=_baseday.2005+365
     _baseday.2007=_baseday.2006+365
     _baseday.2008=_baseday.2007+365
    
     rslt="_g. _s. _p. _d. _v. _f. _m. _q. "
     rslt=rslt||"_ef. _es. _et. _ep. "
     rslt=rslt||"_path. _dist. _dtomsl. _dfrmsl. "
     rslt=rslt||"_bg. _nwi. _od. _sv. _pv. _bust. _vs. _vn. "
     rslt=rslt||"_olist1. _olist2. _clvlist1. _clvlist2. "
     rslt=rslt||"_verbose _monthdays _monthnames _baseday. "
     rslt=rslt||"globals reconnect scriptname lra "
     if arg(1,"E") then rslt=rslt||arg(1)
    
     rslt=_space(rslt)
    return rslt

/** _halt v.3 **/
    _halt: procedure expose (globals)
     call off halt
     call zocwriteln "^[[1;33m< user abort >^[[0m "
     exit
    return

/** _pcheck v.4 **/
    _pcheck: procedure expose (globals)
     pc1=arg(1)
     pc2=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     rslt=0
     do i=1 to _dwords(pc1,";")
      if _instr(_dword(pc1,i,";"),pc2,"cs") then rslt=1
     end /*do*/
    return rslt

/** _error v.7 **/
    _error: procedure expose (globals)
     call off halt
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln
     call zocwrite _ansi("bt;frd")||"< script error"
     if arg(1,"E") then call zocwrite ": "||arg(1)
     call zocwriteln " >"
     call zocwriteln _ansi("bt;fye")||"< if this is a serious problem, email me at: the.reverend@coastgames.com > "
     call zocwriteln "< ZOC VERSION '"||zocgetinfo("VERSION")||"', OS '"||zocgetinfo("OSYS")||"', LOCATION '"||zocgetinfo("CONNECTEDTO")||"' >"
     if arg(2,"E") then call zocwriteln _ansi("bt;fgr")||"< "||arg(2)||" >"
     call zocwrite _ansi()
     call _beep "error.wav"
     if reconnect=1 & arg(1)="timeout" then do
      /* call zocdisconnect */
      call zocwriteln _ansi("bt;fwh")||"< ATTEMPTING TO RECONNECT >"
      call zocdostring "^RUN=_connect.zrx sn="||scriptname
     end /*if*/
    exit

/** _set_ship_catalog v.1 **/
    _set_ship_catalog: procedure expose (globals)
     call _twmsg "OFF"
     call zocsend "cc"
     if zocwait("Which ship are you interested in (?=List) ?")=640 then call _error "timeout"
     
     /* setup ship array */
     nextpage=0
     ship.0=0
     i=1
     buflen=3*1024
     done=0
     do while \done
     
      /* read catalog page into buffer */
      call zocreceivebuf buflen
      if i=1 then call zocsend "?"
      else call zocsend "+"
      if zocwait("Which ship are you interested in (?=List) ?")=640 then call _error "timeout"
      buff=translate(zocreceivebuf(buflen),"  ",d2c(0)||d2c(10))
      if length(buff)=buflen then call _error "buffer overflow"
     
      /* parse ship catalog page */
      j=ship.0
      jj=1
      ii=pos("<",buff,jj)
      if ii>0 then jj=pos(d2c(13),buff,ii)
      do while ii>0 & jj>0
       parse value substr(buff,ii,jj-ii) with "<" letter "> " shipname
       select
        when i>1 & letter="A" & shipname=_dword(ship.1,3,";") then do
         done=1
         leave
        end /*when*/
        when shipname="Next Page" then nextpage=1
        when shipname="To Leave" then nop
        otherwise do
         j=j+1
         ship.j=i||";"||letter||";"||shipname
        end /*otherwise*/
       end /*select*/
       ii=pos("<",buff,jj)
       if ii>0 then jj=pos(d2c(13),buff,ii)
       else jj=0
      end /*do*/
      ship.0=j
     
      if \nextpage then done=1
      i=i+1
     
     end /*do*/
     
     currentpage=1
     do i=1 to ship.0
     
      mshlds=0
      mfigs=0
      mfigattack=0
      offodds=0
      defodds=0
      
      /* get ship description */
      parse var ship.i page ";" letter ";" shipname
      if page>currentpage then do
       currentpage=page
       call zocsend "+"
       if zocwait("Which ship are you interested in (?=List) ?")=640 then call _error "timeout"
       buff=translate(zocreceivebuf(buflen),"  ",d2c(0)||d2c(10))
       if length(buff)=buflen then call _error "buffer overflow"
      end /*if*/
      call zocsend letter
      if zocwait("Which ship are you interested in (?=List) ?")=640 then call _error "timeout"
      buff=translate(zocreceivebuf(buflen),"  ",d2c(0)||d2c(10))
      if length(buff)=buflen then call _error "buffer overflow"
     
      line.i=_parse_ship_desc(buff)
     
      /* parse ship description
      ii=pos("Maximum Shields:",buff)
      if ii>0 then jj=pos(d2c(13),buff,ii)
      else jj=0
      if ii>0 & jj>0 then parse value substr(buff,ii,jj-ii)with "Maximum Shields:" mshlds
     
      ii=pos("Max Fighters:",buff)
      if ii>0 then jj=pos("Offensive Odds:",buff,ii)
      else jj=0
      if ii>0 & jj>0 then parse value substr(buff,ii,jj-ii) with "Max Fighters:" mfigs
      if jj>0 then kk=pos(":1",buff,jj)
      else kk=0
      if jj>0 & kk>0 then parse value substr(buff,jj,kk-jj) with "Offensive Odds:" offodds
     
      ii=pos("Turns Per Warp:",buff)
      if ii>0 then jj=pos("Defensive Odds:",buff,ii)
      else jj=0
      if ii>0 & jj>0 then parse value substr(buff,ii,jj-ii) with "Turns Per Warp:" tpw
      if jj>0 then kk=pos(":1",buff,jj)
      else kk=0
      if jj>0 & kk>0 then parse value substr(buff,jj,kk-jj) with "Defensive Odds:" defodds
     
      ii=pos("Max Figs Per Attack:",buff)
      if ii>0 then jj=pos("TransWarp Drive:",buff,ii)
      else jj=0
      if ii>0 & jj>0 then parse value substr(buff,ii,jj-ii) with "Max Figs Per Attack:" mfigattack
     
      ii=pos("Maximum Holds:",buff)
      if ii>0 then jj=pos("Transport Range:",buff,ii)
      else jj=0
      if ii>0 & jj>0 then parse value substr(buff,ii,jj-ii) with "Maximum Holds:" mholds
      if jj>0 then kk=pos("Photon Missiles:",buff,jj)
      else kk=0
      if jj>0 & kk>0 then parse value substr(buff,jj,kk-jj) with "Transport Range:" range
     
      mshlds=_space(translate(mshlds," ",","),0)
      mfigs=_space(translate(mfigs," ",","),0)
      mfigattack=_space(translate(mfigattack," ",","),0)
      offodds=strip(offodds)
      defodds=strip(defodds)
      mholds=strip(mholds)
      range=strip(range)
      tpw=strip(tpw)
      line.i=mshlds||";"||mfigs||";"||mfigattack||";"||offodds||";"||defodds||";"||mholds||";"||range||";"||tpw
      */
    
     end /*do*/
     
     /* exit ship catalog */
     call zocsend "qq"
     if zocwaitmux("Command [","Citadel command")=640 then call _error "timeout"
     
     call _newline
     parse value _getgameinfo() with spath ";" iname ";" game
     call zocwrite _ansi("bt;fwh")||"writing ship catalog to "||iname||" ["||game||"] "
     
     do i=ship.0 to 1 by -1
      call zocwrite "."
      if \_ini_write(iname,game,"ship."||strip(left(_dword(ship.i,3,";"),23)),line.i) then call _error "unable to write to "||iname
     end /*do*/
     call zocwrite "."
     if \_ini_write(iname,game,"ship.key_long","shipbasecost;maxfigsperattack;maximumholds;initialholds;maxfighters;turnsperwarp;minemax;genesismax;transwarpdrive;transportrange;maximumshields;offensiveodds;defensiveodds;beaconmax;longrangescan;planetscanner;photonmissiles") then call _error "unable to write to "||iname
     if \_ini_write(iname,game,"ship.key","1bcst;2mfgpa;3mhlds;4ihlds;5mfg;6tpw;7mmine;8mgent;9tw;10trng;11mshlds;12offodds;13defodds;14mbeac;15lrs;16ps;17phot") then call _error "unable to write to "||iname
     
     call zocsend "|"
     if zocwaitmux("Command [","Citadel command")=640 then call _error "timeout"
    
    return

/** _quit v.7 **/
    _quit: procedure expose (globals)
     lcpy=1
     arg1=""
     do i=1 to 2 /* manage arguments */
      select
       when arg(i,"E") & lower(arg(i))="nocopy" then lcpy=0
       when arg(i,"E") & arg1="" then arg1=arg(i)
       otherwise nop
      end /*select*/
     end /*do*/
     line=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     select /* define message */
      when  lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m^M^J"||line
      when \lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m "
      when  lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m^M^J"||line
      when \lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m "
      otherwise nop
     end /*select*/
     call zocwrite msg
     select /* choose a beep */
      when lower(arg1)="script cancelled by user." then call _beep "cancel.wav"
      otherwise call _beep "quit.wav"
     end /*select*/
     exit
    return 1

/** _space v.1 **/
    _space: procedure expose (globals)
     str=strip(arg(1))
     if arg(2,"E") then n=arg(2); else n=1
     if arg(3,"E") then pad=arg(3); else pad=" "
     rslt=word(str,1)
     do i=2 to words(str)
      rslt=rslt||copies(pad,n)||word(str,i)
     end /*do*/
    return rslt

/** _dwords v.2 **/
    _dwords: procedure expose (globals)
     rslt=words(translate(arg(1),arg(2)||" "," "||arg(2)))
    return rslt

/** _instr v.3 **/
    _instr: procedure expose (globals)
     fnd=arg(1)
     str=arg(2)
     if lower(arg(3))\="cs" then do
      fnd=lower(fnd)
      str=lower(str)
     end /*if*/
     if arg(1,"E") & arg(2,"E") & pos(fnd,str)>0 then rslt=1
     else rslt=0
    return rslt

/** _dword v.2 **/
    _dword: procedure expose (globals)
     rslt=translate(word(translate(arg(1),arg(3)||" "," "||arg(3)),arg(2))," "||arg(3),arg(3)||" ")
    return rslt

/** _ansi v.3 **/
    _ansi: procedure expose (globals)
     rslt="0"
     do i=1 to _dwords(arg(1),";")
      w=_dword(arg(1),i,";")
      select
       when w="dl"  then rslt=rslt||";"||0  /* dull               */
       when w="bt"  then rslt=rslt||";"||1  /* bright             */
       when w="ul"  then rslt=rslt||";"||4  /* underlined         */
       when w="blk" then rslt=rslt||";"||5  /* blinking           */
       when w="fbk" then rslt=rslt||";"||30 /* black foreground   */
       when w="frd" then rslt=rslt||";"||31 /* red foreground     */
       when w="fgr" then rslt=rslt||";"||32 /* green foreground   */
       when w="fye" then rslt=rslt||";"||33 /* yellow foreground  */
       when w="fbl" then rslt=rslt||";"||34 /* blue foreground    */
       when w="fmg" then rslt=rslt||";"||35 /* magenta foreground */
       when w="fcy" then rslt=rslt||";"||36 /* cyan foreground    */
       when w="fwh" then rslt=rslt||";"||37 /* white foreground   */
       when w="bbk" then rslt=rslt||";"||40 /* black background   */
       when w="brd" then rslt=rslt||";"||41 /* red background     */
       when w="bgr" then rslt=rslt||";"||42 /* green background   */
       when w="bye" then rslt=rslt||";"||43 /* yellow background  */
       when w="bbl" then rslt=rslt||";"||44 /* blue background    */
       when w="bmg" then rslt=rslt||";"||45 /* magenta background */
       when w="bcy" then rslt=rslt||";"||46 /* cyan background    */
       when w="bwh" then rslt=rslt||";"||47 /* white background   */
       otherwise nop
      end /*select*/
     end /*do*/
     rslt="^[["||rslt||"m"
    return rslt

/** _beep v.2 **/
    _beep: procedure expose (globals)
     select
      when arg(1,"O") then call zocwrite d2c(7)
      when _fileexists(arg(1)) then call zocplaysound arg(1)
      otherwise call zocwrite d2c(7)
     end /*select*/
    return

/** _twmsg v.2 **/
    _twmsg: procedure expose (globals)
     if arg(1)="" then call _error "missing parameter."
     select
      when lower(arg(1))="on" then do
       msg1="Silencing"
       msg2="Displaying all messages"
      end /*when*/
      when lower(arg(1))="off" then do
       msg1="Displaying"
       msg2="Silencing all messages"
      end /*when*/
      otherwise call _error "invalid parameter."
     end /*select*/
     call zocrespond msg1, "|"
     call zocsend "|"
     if zocwait(msg2)=640 then call _error "timeout"
     call zocrespond msg1
    return

    /* _parse_ship_desc v.1 */
    _parse_ship_desc:  procedure expose (globals)
     buff=arg(1)
     rslt=""
    
     i=pos("Basic Hold Cost:",buff)
     j=pos(d2c(13),buff,i)
     line.1=strip(substr(buff,i,j-i))
     parse var line.1 ":" basicholdcost . ":" initialholds . ":" maximumshields .
     basicholdcost=_stripcomma(strip(basicholdcost))
     maximumshields=_stripcomma(strip(maximumshields))
    
     i=pos("Main Drive Cost:",buff,j+1)
     j=pos(d2c(13),buff,i)
     line.2=strip(substr(buff,i,j-i))
     parse var line.2 ":" maindrivecost . ":" maxfighters . ":" offensiveodds .
     maindrivecost=_stripcomma(strip(maindrivecost))
     maxfighters=_stripcomma(strip(maxfighters))
     offensiveodds=_dword(strip(offensiveodds),1,":")
    
     i=pos("Computer Cost:",buff,j+1)
     j=pos(d2c(13),buff,i)
     line.3=strip(substr(buff,i,j-i))
     parse var line.3 ":" computercost . ":" turnsperwarp . ":" defensiveodds .
     computercost=_stripcomma(strip(computercost))
     defensiveodds=_dword(strip(defensiveodds),1,":")
    
     i=pos("Ship Hull Cost:",buff,j+1)
     j=pos(d2c(13),buff,i)
     line.4=strip(substr(buff,i,j-i))
     parse var line.4 ":" shiphullcost . ":" minemax . ":" beaconmax .
     shiphullcost=_stripcomma(strip(shiphullcost))
     minemax=strip(minemax)
     beaconmax=strip(beaconmax)
    
     i=pos("Ship Base Cost:",buff,j+1)
     j=pos(d2c(13),buff,i)
     line.5=strip(substr(buff,i,j-i))
     parse var line.5 ":" shipbasecost . ":" genesismax . ":" longrangescan .
     shipbasecost=_stripcomma(strip(shipbasecost))
     genesismax=strip(genesismax)
     longrangescan=pos("Y",strip(longrangescan))
    
     i=pos("Max Figs Per Attack:",buff,j+1)
     j=pos(d2c(13),buff,i)
     line.6=strip(substr(buff,i,j-i))
     parse var line.6 ":" maxfigsperattack . ":" transwarpdrive . ":" planetscanner .
     maxfigsperattack=_stripcomma(strip(maxfigsperattack))
     transwarpdrive=pos("Y",strip(transwarpdrive))
     planetscanner=pos("Y",strip(planetscanner))
    
     i=pos("Maximum Holds:",buff,j+1)
     j=pos(d2c(13),buff,i)
     line.7=strip(substr(buff,i,j-i))
     parse var line.7 ":" maximumholds . ":" transportrange . ":" photonmissiles .
     maximumholds=strip(maximumholds)
     transportrange=strip(transportrange)
     photonmissiles=pos("Y",strip(photonmissiles))
    
     rslt=shipbasecost maxfigsperattack maximumholds initialholds maxfighters turnsperwarp minemax genesismax ,
          transwarpdrive transportrange maximumshields offensiveodds defensiveodds beaconmax longrangescan ,
          planetscanner photonmissiles
     rslt=translate(rslt,";"," ")
    
    return rslt
    
    /*
    
    Which ship are you interested in (?=List) ?
    You shut off the Vid Term.
    
    Computer command [TL=00:00:00]:[3156] (?=Help)? ;
    
                                  Corporate FlagShip
    
         Basic Hold Cost:   10,000   Initial Holds:     20 Maximum Shields: 1,500
         Main Drive Cost:    5,000    Max Fighters: 20,000  Offensive Odds: 1.2:1
           Computer Cost:  120,000  Turns Per Warp:      3  Defensive Odds: 1.2:1
          Ship Hull Cost:   28,500        Mine Max:    100      Beacon Max:   100
          Ship Base Cost:  163,500     Genesis Max:     10 Long Range Scan:   Yes
     Max Figs Per Attack:     6000 TransWarp Drive:    Yes  Planet Scanner:   Yes
           Maximum Holds:       85 Transport Range:     10 Photon Missiles:    No
    
    Computer command [TL=00:00:00]:[3156] (?=Help)?
    */

/** _newline v.2 **/
    _newline: procedure expose (globals)
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln arg(1)
     else call zocwrite arg(1)
    return

/** _getgameinfo v.5 **/
    _getgameinfo: procedure expose (globals)
     spath=_getscriptpath()
     base=spath||"script.ini"
    
     if arg(1,"E") then fname=arg(1)
     else fname=base
    
     parse value zocgetglobaloption("WindowTitle") with . '="' game '"'
     if fname\=base | game="" | game="%ZOCORHOST% %OPTIONS%" then do
      list=_ini_getheadings(fname)
      if list="##EOF##" then game="##EOF##"
      else do
       templist=""
       do i=1 to _dwords(list,";")
        temp=_dword(list,i,";")
        if left(temp,1)\="*" then do
         if templist="" then templist=temp
         else templist=templist||";"||temp
        end /*if*/
       end /*do*/
       list=templist
       game=_drequestlist("select a game:", list, ";", "c")
      end /*else*/
     end /*do*/
    
     call zocwrite _ansi("bt;fgr")||"< using "
     if length(fname)>17 then call zocwrite "..."
     call zocwriteln right(fname,min(length(fname),17))||" - ["||game||"] >"
    
     rslt=spath||";"||fname||";"||game
    return rslt

/** _ini_write v.3 **/
    /*_ v.3 tested -*/
    _ini_write: procedure expose (globals)
     /* argument check */
     do i=1 to 4
      if \arg(i,"E") | arg(i,"O") then call _error "missing arguments in _ini_write."
     end /*do*/
    
     /* name arguments */
     fname=arg(1)
     s=strip(arg(2))
     k=strip(arg(3))
     v=strip(arg(4))
    
     tname=fname||".tmp"
     written=0
     
     rslt=0
     if _fileopenr(fname) then do
      if _fileexists(tname) then if \dosdel(tname) then call _error "file delete failed."
      if _fileopenw(tname) then do
       insection=0
       linenum=0
       do while \_fileeof(fname)
        line=strip(linein(fname))
        linenum=linenum+1
        select
         when line="["||s||"]" then do
          insection=1
          if linenum>1 then call lineout tname, ""
          call lineout tname, line
          call charout tname, k||"="||v
          written=1
         end /*when*/
         when insection & left(line,length(k)+1)=k||"=" then nop
         when insection & left(line,1)="[" then do
          if linenum>1 then call lineout tname, ""
          call charout tname, line
          insection=0
         end /*when*/
         when line="" then do
          if linenum>1 then call lineout tname, ""
          call charout tname, ""
         end /*when*/
         otherwise do
          if linenum>1 then call lineout tname, ""
          call charout tname, line
         end /*otherwise*/
        end /*select*/
       end /*do*/
       if \written then do
        if linenum>1 then call lineout tname, ""
        call lineout tname, "["||s||"]"
        call charout tname, k||"="||v
        written=1
       end /*if*/
       call _fileclose(tname)
      end /*if*/
      call _fileclose(fname)
     end /*if*/
     if written then do
      if \dosdel(fname) then call _error "file delete failed."
      if \dosrename(tname,fname) then call _error "file rename failed."
     end /*if*/
     else do
      if \_fileexists(fname) then do
       if _filenew(fname) then do
        call lineout fname, "["||s||"]"
        call charout fname, k||"="||v
        call _fileclose(fname)
        written=1
       end /*if*/
      end /*if*/
     end /*else*/
    return written

/** _fileexists v.3 **/
    _fileexists: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileexists"
     if stream(arg(1), "C", "QUERY EXISTS")="" then rslt=0; else rslt=1
    return rslt

/** _stripcomma v.1 **/
    _stripcomma: procedure expose (globals)
     rslt=translate(_space(translate(arg(1),", "," ,"),0)," ",",")
    return rslt

/** _getscriptpath v.1 **/
    _getscriptpath:
     parse value zocgetglobaloption("ScriptPath") with . '="' spath '"'
     spath=dosfname(spath)
     if right(spath,1)\="\" then spath=spath||"\"
     if \dosisdir(spath) then call _error "invalid path in _getscriptpath"
    return spath

/** _ini_getheadings v.5 **/
    _ini_getheadings: procedure expose (globals)
     if arg(1,"E") then fname=arg(1)
     else call _error "missing parameter in _ini_getheadings"
     if arg(2,"E") then delim=left(arg(2),1)
     else delim=";"
     list=""
     if _fileopenr(fname) then do
      do while \_fileeof(fname)
       line=strip(linein(fname))
       if left(line,1)="[" then do
        if list="" then list=strip(translate(line,"  ","[]"))
        else list=list||delim||strip(translate(line,"  ","[]"))
       end /*if*/
      end /*do*/
      call _fileclose fname
     end /*do*/
     if list="" then list="##EOF##"
    return list

/** _drequestlist v.3 **/
    _drequestlist: procedure expose (globals)
     i=zocrequestlist(arg(1),translate(arg(2),"|"||arg(3),arg(3)||"|"))
     select
      when i<0 & lower(arg(4))="c" then call _quit "script cancelled by user.", "nocopy"
      when i<0 then rslt="##CANCEL##"
      otherwise rslt=_dword(arg(2),i+1,arg(3))
     end /*select*/
    return rslt

/** _fileopenr v.4 **/
    _fileopenr: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileopenr"
     if _fileexists(arg(1)) then do
      call stream arg(1), "C", "OPEN READ"
      rslt=_fileready(arg(1))
      if \rslt then call _fileclose arg(1)
     end /*if*/
     else rslt=0
    return rslt

/** _fileopenw v.3 **/
    _fileopenw: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileopenw"
     if _fileexists(arg(1)) then do
      call stream arg(1), "C", "OPEN WRITE"
      call stream arg(1), "C", "SEEK <0"
      rslt=_fileready(arg(1))
      if \rslt then call _fileclose arg(1)
     end /*if*/
     else rslt=_filenew(arg(1))
    return rslt

/** _fileeof v.4 **/
    _fileeof: procedure expose (globals)
     rslt=\lines(arg(1))
    return rslt

/** _fileclose v.3 **/
    _fileclose: procedure expose (globals)
     if \arg(1,"E") then call _error "missing argument in _fileclose"
     call stream arg(1), "C", "CLOSE"
    return

/** _filenew v.4 **/
    _filenew: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _filenew"
     if arg(2,"E") & lower(arg(2))="delete" then call dosdel arg(1)
     if _fileexists(arg(1)) then rslt=0
     else do
      call stream arg(1), "C", "OPEN WRITE"
      rslt=_fileready(arg(1))
      if \rslt then call _fileclose arg(1)
     end /*else*/
    return rslt

/** _fileready v.1 **/
    _fileready: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileready"
     if stream(arg(1), "S")\="NOTREADY" then rslt=1; else rslt=0
    return rslt